;;; $Id: lamp.sld 250 2013-10-22 16:40:25Z alan.watson.f $

(define-library (oaxaca lamp)

  (export lamp-initialized?
          lamp-command
          lamp-idle!
          lamp-idle?
          lamp-wait
          lamp-state
          lamp-set-state!)

  (import (scheme base)
          (scheme char)
          (scheme time))

  (import (prefix (oaxaca foreign) foreign:)
          (oaxaca log)
          (oaxaca thread))

  (begin

    (define (lamp-initialized?)
      (not (zero? (foreign:lamp-initialized))))

    (define (check-lamp-initialized)
      (unless (lamp-initialized?)
        (error "the lamp is not initialized."))
      (values))

    (define (lamp-idle?)
      (eqv? #\I (foreign:lamp-command)))

    (define (check-lamp-idle)
      (unless (lamp-idle?)
        (error "the lamp is not idle."))
      (values))

    (define (lamp-idle!)
      (check-lamp-initialized)
      (lamp-command! #\i #\I)
      (values))

    (define (lamp-wait)
      (thread-wait-until! lamp-idle?)
      (values))

    (define (lamp-state)
      (not (zero? (foreign:lamp-state))))

    (define (lamp-set-state! state)
      (check-lamp-initialized)
      (lamp-command! (if state #\1 #\0) #\I))

    (define (lamp-command)
      (foreign:lamp-command))

    (define (lamp-command! command acknowledgement)
      (check-lamp-initialized)
      (foreign:lamp-set-command! command)
      (thread-wait-until!
       (lambda ()
         (char=? (foreign:lamp-command) acknowledgement)))
      (values))))